home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Tools / Freeware / AmiPCB / ARexx / CheckComp.AmiPCB < prev    next >
Encoding:
Text File  |  2002-03-13  |  6.5 KB  |  192 lines
  1. /* Test d'un composant */
  2. /* Ce script peut être appelé de deux façons:
  3.     - en sélectionnant d'abord le composant à tester
  4.     - en choisissant le composant à tester à l'aide
  5.     de la requête de fichiers */
  6. /* Le script teste la présence d'une référence et d'une valeur
  7. ainsi que les numéros des pastilles (manque numérotation, même
  8. numéros utilisés plusieurs fois) */
  9. /* Version 1.00: 22 août 2001, (localisation français/anglais) */
  10. /* Version 1.01: 24 novembre 2001, (ajout test nom) */
  11. /* Version 1.02: 28 décembre 2001, traduction allemand (Greve Axel) */
  12. /* $VER: CheckComp.AmiPCB 1.02 (© R.Florac/A.Greve, 28-Dec-2001) */
  13.  
  14. options results     /* indispensable pour récupérer le résultat des macros */
  15.  
  16. signal on error     /* pour l'interception des erreurs */
  17. signal on syntax
  18.  
  19. lf = '0a'x
  20.  
  21. fr = 'ARexx/InitVars.AmiPCB'()
  22.  
  23. 'FIRSTSEL'
  24. if result=0 then do
  25.     path=getclip(checkcomp_path)
  26.     if path="" then do
  27.     'CLIPPATH("")'
  28.     path=result
  29.     end
  30.     select
  31.         when fr=1 then 'REQFILE("Composant à tester","'path'","")'
  32.         when fr=2 then 'REQFILE("Zu prüfende Komponente","'path'","")'
  33.         otherwise      'REQFILE("Component to check","'path'","")'
  34.     end
  35.     composant=result
  36.     if composant='' then exit
  37.  
  38.     'LOADCLIP(5,"'composant'")'
  39.     no=result
  40.     if no<1 then exit
  41.     call addlib("rexxdossupport.library",0,-30,2)
  42.     path=PathPart(composant)
  43.     call setclip(checkcomp_path,path)
  44.     'UNMARK(0):PASTE(5,762,762)'
  45.     if result~=no then do
  46.         select
  47.             when fr=1 then 'MESSAGE("Positionnement composant impossible")'
  48.             when fr=2 then 'MESSAGE("Platzierung der Komponente unmöglich")'
  49.             otherwise       'MESSAGE("Placement of the component impossible")'
  50.         end
  51.         exit
  52.     end
  53.     'MENU("Fix"):ROTATE(0,0):SYMMETRY(0,0):SETSIDE(0,4):WRITE("'composant'",800,800)'
  54. end
  55.  
  56. 'FIRSTSEL'
  57. if result=0 then do
  58.     select
  59.         when fr=1 then 'MESSAGE("Sélectionnez le composant'lf'à tester avant'lf'd''appeler ce script !")'
  60.         when fr=2 then 'MESSAGE("Selektieren Sie die zu'lf'prüfende Komponente vor'lf'dem Aufruf dieses Skripts !")'
  61.         otherwise      'MESSAGE("Select the component'lf'to check before'lf'calling this script !")'
  62.     end
  63.     exit
  64. end
  65.  
  66. /* Test appartenance à un groupe */
  67. select
  68.     when fr=1 then do
  69.         msg1 = "Attention un élément au moins"lf"n'appartient pas à un groupe"
  70.         msg2 = "ATTENTION"lf"Tous les objets ne font"lf"pas partie du même groupe !"
  71.     end
  72.     when fr=2 then do
  73.         msg1 = "WARNUNG"lf"Mindestens ein Element ist"lf"nicht in einer Gruppe enthalten"
  74.         msg2 = "WARNUNG"lf"Die Objekte sind nicht"lf"in derselben Gruppe !"
  75.     end
  76.     otherwise do
  77.         msg1 = "Warning an element or more"lf"is not included in a group"
  78.         msg2 = "WARNING"lf"All the objects are not"lf"in the same group !"
  79.     end
  80. end
  81. 'INIT(O,G,REF,VAL):O=FIRSTSEL:G=GROUP(O):IF(G==0,MESSAGE("'msg1'"):O=-1,WHILE(O>0,IF(GROUP(O)<>G,MESSAGE("'msg2'"):O=-1,O=NEXTSEL(O)))):O'
  82. if result=-1 then exit
  83.  
  84. /* Test du nom du groupe */
  85. 'GETNAME(G)'
  86. if result="" then do
  87.     select
  88.     when fr=1 then 'MESSAGE("ATTENTION'lf'Le composant ne possède'lf'pas de nom")'
  89.     when fr=2 then 'MESSAGE("Warnung: Die Komponente'lf'hat keinen Namen")'
  90.     otherwise      'MESSAGE("Warning: the component'lf'has no name")'
  91.     end
  92.     exit
  93. end
  94.  
  95. /* Test référence */
  96. 'O=FIRSTSEL:REF=0:WHILE(O>0,IF(TYPE(O)==5,REF=REF+1,0):O=NEXTSEL(O)):REF'
  97. if result=0 then do
  98.     select
  99.         when fr=1 then 'MESSAGE("ATTENTION'lf'Le composant ne possède'lf'pas de référence")'
  100.         when fr=2 then 'MESSAGE("WARNUNG'lf'Die Komponente besitzt'lf'keine Referenz")'
  101.         otherwise      'MESSAGE("WARNING'lf'The component has'lf'no reference")'
  102.     end
  103.     exit
  104. end
  105. else if result>1 then do
  106.     select
  107.         when fr=1 then 'MESSAGE("ATTENTION'lf'Le composant possède'lf'plusieurs références")'
  108.         when fr=2 then 'MESSAGE("WARNUNG'lf'Die Komponente besitzt'lf'mehrere Referenzen")'
  109.         otherwise      'MESSAGE("WARNING'lf'The component has'lf'several references")'
  110.     end
  111.     exit
  112. end
  113.  
  114. /* Test valeur */
  115. 'O=FIRSTSEL:VAL=0:WHILE(O>0,IF(TYPE(O)==VALUE,VAL=VAL+1,0):O=NEXTSEL(O)):VAL'
  116. if result=0 then do
  117.     select
  118.         when fr=1 then 'MESSAGE("ATTENTION'lf'Le composant ne possède'lf'pas de valeur")'
  119.         when fr=2 then 'MESSAGE("WARNUNG'lf'Die Komponente besitzt'lf'keinen Wert")'
  120.         otherwise      'MESSAGE("WARNING'lf'The component has'lf'no value")'
  121.     end
  122. end
  123. else do
  124.     if result>1 then do
  125.         select
  126.             when fr=1 then 'MESSAGE("ATTENTION'lf'Le composant possède'lf'plusieurs valeurs")'
  127.             when fr=2 then 'MESSAGE("WARNUNG'lf'Die Komponente besitzt'lf'mehrere Werte")'
  128.             otherwise       'MESSAGE("WARNING'lf'The component has'lf'several values")'
  129.         end
  130.     end
  131. end
  132.  
  133. /* Test des numéros de bornes */
  134. pins=0
  135. unpin=0
  136. 'FINDOBJ('obj',-PAD,-1,-1)'
  137. obj=result
  138. do while obj>0
  139.     'PADNUM('obj',-1)'
  140.     pin.pins=result
  141.     if pin.pins=0 then unpin=unpin+1
  142.     pins=pins+1
  143.     'FINDOBJ('obj',-PAD,-1,-1)'
  144.     obj=result
  145. end
  146. if unpin>0 then do
  147.     'CALL("CheckPads")'
  148.     exit
  149. end
  150. do i=0 to pins-1
  151.     do j=i+1 to pins-1
  152.     if pin.i=pin.j & i~=j then do
  153.             select
  154.                 when fr=1 then 'MESSAGE("ATTENTION'lf'Il y a plusieurs broches numérotées 'pin.i'")'
  155.                 when fr=2 then 'MESSAGE("WARNUNG'lf'Mehrere Pins haben die Nummer 'pin.i'")'
  156.                 otherwise      'MESSAGE("WARNING'lf'Several pins have number 'pin.i'")'
  157.             end
  158.         'FINDOBJ(0,-PAD,-1,-1)'
  159.             pad=result
  160.         obj=''
  161.         do while pad>0
  162.             'PADNUM('pad',-1)'
  163.             if result=pin.i then do
  164.             if obj='' then obj=pad
  165.             else obj=obj||','||pad
  166.             end
  167.             'FINDOBJ('pad',-PAD,-1,-1)'
  168.             pad=result
  169.         end
  170.         'UNMARK(0):MARK('obj')'
  171.         exit
  172.     end
  173.     end
  174. end
  175.  
  176. select
  177.     when fr=1 then 'MESSAGE(IF(VAL>0,"Le composant comprend une valeur'lf'et une référence","Le composant comprend une référence")+"'lf'Ses pastilles sont numérotées'lf'correctement, il peut être'lf'utilisé normalement")'
  178.     when fr=2 then 'MESSAGE(IF(VAL>0,"Die Komponente hat einen Wert'lf'und eine Referenz","Die Komponente hat eine Referenz")+"'lf'und ihre Pins sind korrekt nummeriert,'lf'sie kann normal verwendet werden")'
  179.     otherwise       'MESSAGE(IF(VAL>0,"The component has a value'lf'and a reference","The component has a reference")+"'lf'His pads are numbered'lf'correctly, it can'lf'be used normaly")'
  180. end
  181. exit
  182.  
  183. /* Traitement des erreurs, interruption du programme */
  184. syntax:
  185. erreur=RC
  186. Call 'ARexx/_Syntax.rexx'(fr,'CheckComp.AmiPCB',SIGL,erreur)
  187. exit
  188.  
  189. error:
  190. Call 'ARexx/_Error.rexx'(fr,'CheckComp.AmiPCB',SIGL)
  191. exit
  192.